module Hand where

import List
import Util
import Test.HUnit hiding (test)

import qualified Card
import qualified Deck

----------------------- HandRank code -----------------------------------------

-- |The HandRank data represents all of the possible hands of Poker
--  We constructured each hand by grouping matched rank cards (pair, 
--  triple, quad) into one Card.Rank value and then all of the 
--  remaining cards into a list. When a HandRank is constructed 
--  properly it is possible to do a correct comparison between hands
--  using the derived Ord and Eq definitions because Card.Rank is an
--  Int and therefore has Ord and Eq instance definitions.
data HandRank = HighCard [Card.Rank] -- Full hand
              | Pair Card.Rank [Card.Rank] -- Pair + 3
              | TwoPair Card.Rank Card.Rank Card.Rank -- Two pair + 1
              | ThreeOf Card.Rank [Card.Rank] -- Three + 2
              | Straight Card.Rank -- High card
              | Flush [Card.Rank] -- Full hand
              | FullHouse Card.Rank Card.Rank -- Triple Double
              | FourOf Card.Rank Card.Rank -- Four + 1
              | StraightFlush Card.Rank
                deriving (Ord, Eq)

-- Provides poker-style explanations of HandRanks.
instance Show HandRank where
    show (HighCard rs)      = (Card.rankName $ head rs) ++ " high"
    show (Pair r rs)        = "pair of " ++ (Card.rankName r) ++ "s"
    show (TwoPair r1 r2 rs) = "pairs of " ++ (Card.rankName r1) ++ "s and " 
                                ++ (Card.rankName r2) ++ "s"
    show (ThreeOf r rs)     = "three " ++ (Card.rankName r) ++ "s"
    show (Straight r)       = (Card.rankName r) ++ " high straight"
    show (Flush rs)         = (Card.rankName $ head rs) ++ " high flush"
    show (FourOf r rs)      = "four " ++ (Card.rankName r) ++ "s"
    show (StraightFlush r)  = if r == 14 then "royal flush"
                              else (Card.rankName r) ++ " high straight flush"

-- |Takes a list of Cards and constructs the appropriate HandRanks such that
-- they can be accurately compared and tie-broken.  This means that each element
-- of the hand is put in by its poker rank (triples before pairs, pairs before
-- single cards, and everything in high-to-low rank order).
rankHand :: [Card.T] -> HandRank
rankHand hand = let sorted = map Card.rank (sort hand)
                    isFlush = checkFlush hand
                    isStraight = checkStraight sorted in
                if isStraight && isFlush
                   then StraightFlush $ last sorted
                else if isStraight
                   then Straight $ last sorted
                else if isFlush
                   then Flush $ reverse sorted
                else rankDups hand

-- |Detects a straight in a list of sorted ranks by checking that the ranks are
-- increasing by one.
checkStraight :: [Card.Rank] -> Bool
checkStraight cs = increasingByOne cs

-- |Detects a flush in a hand by checking the last four cards have the same
--  suit as the first.
checkFlush :: [Card.T] -> Bool
checkFlush (c:cs) = countWith ((Card.suit c ==) . Card.suit) cs == 4

-- |Detects all the hands which consist of sets of cards with the same rank.
rankDups :: [Card.T] -> HandRank
rankDups hand = 
    let ranks = map Card.rank hand 
        dups = countDups ranks
        ordering (_,a) (_,b) = compare b a
        sorted = sortBy ordering dups in -- order by how many duplicates
    case sorted of
      [(a,1),(b,1),(c,1),(d,1),(e,1)] -> HighCard $ reverse $ sort ranks
      [(a,2),(b,1),(c,1),(d,1)]       -> Pair a $ reverse $ sort [b,c,d]
      [(a,2),(b,2),(c,1)]             -> TwoPair (max a b) (min a b) c
      [(a,3),(b,1),(c,1)]             -> ThreeOf a $ reverse $ sort [b,c]
      [(a,3),(b,2)]                   -> FullHouse a b
      [(a,4),(b,1)]                   -> FourOf a b
      _                               -> error $ "Invalid hand: " ++ (show hand)

-- |Makes a hand (list of Cards) from a string description
mkHand :: String -> [Card.T]
mkHand = map Card.justParse . words

-- |HUnit test for proper hand ranking
testRank h1 h2 = TestCase (assertBool (h1 ++ " < " ++ h2)
                           ((rankHand $ mkHand h1) < (rankHand $ mkHand h2)))

rankTests = TestList [(testRank "2H 3H 4H 5S 7C" "2H 2S 3H 4H 5H"),
                      (testRank "2H 4S 6C 7D 9D" "AH 3H 5H 7C 8H"),
                      (testRank "4H 4S 4C 4D 2S" "10H JH QH KH AH")] 